home *** CD-ROM | disk | FTP | other *** search
/ Multimedia Toolkit / Multimedia Toolkit.iso / pascal / vid43.pas < prev    next >
Pascal/Delphi Source File  |  1993-03-22  |  5KB  |  242 lines

  1. UNIT Vid43;
  2.  
  3. INTERFACE
  4.  
  5. USES Dos;
  6.  
  7.  
  8.  
  9.  
  10. CONST
  11.   ScreenSizeX  : WORD = 80;
  12.   ScreenBytesX : WORD = 160;
  13.   ScreenSizeY  : WORD = 43;
  14.   ScreenBytes  : WORD = 160 * 43;
  15.   ScreenWords  : WORD = 80 * 43;
  16.   ScrSegment   : WORD = $B800;
  17.   ScrOffset    : WORD = $0000;
  18.  
  19.   ForceEGA     : BOOLEAN = TRUE;
  20.  
  21.   InVideoMode43 : BOOLEAN = FALSE;
  22.  
  23. VAR
  24.   BIOSScrSize   : WORD ABSOLUTE 0:$44C;
  25.   BIOSScrOffset : WORD ABSOLUTE 0:$44E;
  26.  
  27.  
  28.  
  29.  
  30. PROCEDURE InitVid43;
  31. PROCEDURE PoneVideoMode43;
  32. PROCEDURE QuitaVideoMode43;
  33.  
  34.  
  35.  
  36.  
  37. IMPLEMENTATION
  38.  
  39. USES Debugging, FileUtil, BiosVideo, Heaps, SwapManager;
  40.  
  41. TYPE
  42.   TChar = ARRAY[0..7] OF BYTE;
  43.  
  44. CONST
  45.   OldMode         : BYTE    = $FF;
  46.   SaveBufferRec   : TVideoStateSaved = (Mode: 3; FontSize: 16; Buffer: NIL);
  47.   SaveBufferSize  : WORD    = 0;
  48.   SaveBufferNotValid : BOOLEAN = TRUE;
  49.  
  50. VAR
  51.   ScrImageHandle  : TSwapHandle;
  52.  
  53.  
  54. CONST
  55.   DefPalette : ARRAY[1..17] OF BYTE = ($00, $01, $02, $03, $04, $05, $14, $07,
  56.                                        $38, $39, $3A, $3B, $3C, $3D, $3E, $3F,
  57.                                        $00);
  58.  
  59.   Palette : ARRAY[1..17] OF BYTE = {($00, $01, $3B, $03, $04, $3F, $14, $07,
  60.                                      $38, $39, $3A, $3B, $3C, $3D, $3E, $3F,
  61.                                      $00);}
  62.  
  63.                                    ($00, $07, $3F, $24, $3A, $01, $38, $3E,
  64.                                     $00, $07, $3F, $24, $3A, $01, $38, $3E,
  65.                                     $00);
  66.  
  67.   { Negro, Gris, Blanco, Rojo, Verde, Azul, Gris oscuro, Amarillo }
  68.   {  0       1     2      3     4      5         6           7    }
  69.  
  70. {$L FONT.OBJ}
  71. PROCEDURE Font8x8; EXTERNAL;
  72.  
  73. VAR
  74.   PixFont8x8 : ARRAY[0..255] OF TChar;
  75.  
  76.  
  77.  
  78.  
  79. PROCEDURE PoneVideoMode43;
  80.   VAR
  81.     i : WORD;
  82.   BEGIN
  83.  
  84.     IF InVideoMode43 THEN EXIT;
  85.  
  86.     IF NOT SaveBufferNotValid THEN
  87.       SaveVideoState(SaveBufferRec)
  88.     ELSE
  89.       OldMode := GetVideoMode;
  90.  
  91.     ScrImageHandle.Write(Ptr($B800, BIOSScrOffset)^, BIOSScrSize);
  92.  
  93.     IF ForceEGA AND NOT Debug THEN
  94.       ForceEGAMode;
  95.  
  96.     SetVideoMode(3);
  97.  
  98.     SelectFont8x8(0);
  99.     FOR i := 1 TO 7 DO
  100.       SelectFontQuiet8x8(i);
  101.  
  102.     IF NOT Debug THEN
  103.       BEGIN
  104.         FillFont(0, #0, 256, 8, @Font8x8);
  105.         FillFont(1, #0, 256, 8, @PixFont8x8);
  106.         SelectFonts(0, 1);
  107.       END;
  108.  
  109.     BlinkOff;
  110.  
  111.     NoCursor;
  112.     SetCursor(0, 50, 0);
  113.     FillVideoMemory(' ', $00);
  114.     IF NOT Debug THEN
  115.       SetPalette(@Palette);
  116.     SetVideoPage(1);
  117.     FillVideoMemory(' ', $10);
  118.  
  119.     ScrOffset := BIOSScrOffset;
  120.  
  121.     InVideoMode43 := TRUE;
  122.  
  123.   END;
  124.  
  125.  
  126. PROCEDURE QuitaVideoMode43;
  127.   BEGIN
  128.  
  129.     IF NOT InVideoMode43 THEN EXIT;
  130.  
  131.     IF NOT SaveBufferNotValid THEN
  132.       RestoreVideoState(SaveBufferRec)
  133.     ELSE
  134.       SetVideoMode(OldMode);
  135.  
  136.     ScrImageHandle.Read(Ptr($B800, BIOSScrOffset)^, BIOSScrSize);
  137.     ScrImageHandle.Free;
  138. {
  139.     LoadFile(VideoBufPath, Ptr($B800, BIOSScrOffset)^, BIOSScrSize);
  140. }
  141.     InVideoMode43 := FALSE;
  142.   END;
  143.  
  144.  
  145.  
  146.  
  147. VAR
  148.   OldExitProc : POINTER;
  149.  
  150.  
  151. PROCEDURE MyExitProc; FAR;
  152.   BEGIN
  153. {
  154.     QuitaVideoMode43;
  155.     ScrImageHandle.Done;
  156. }
  157.     ExitProc := OldExitProc;
  158.   END;
  159.  
  160.  
  161.  
  162.  
  163. PROCEDURE PokePixel(VAR Ch: TChar; w, i: BYTE);
  164.   BEGIN
  165.  
  166.     CASE i OF
  167.       1: BEGIN
  168.            Ch[0] := Ch[0] AND NOT w;
  169.            Ch[1] := Ch[1] AND NOT w;
  170.            IF w <> $C0 THEN
  171.              IF (Ch[3] AND (w SHL 2)) = 0 THEN
  172.                Ch[2] := Ch[2] AND NOT (w SHL 1);
  173.          END;
  174.       2: BEGIN
  175.            Ch[3] := Ch[3] AND NOT w;
  176.            Ch[4] := Ch[4] AND NOT w;
  177.            IF w <> $C0 THEN
  178.              BEGIN
  179.                IF (Ch[1] AND (w SHL 2)) = 0 THEN
  180.                  Ch[2] := Ch[2] AND NOT (w SHL 1);
  181.                IF (Ch[6] AND (w SHL 2)) = 0 THEN
  182.                  Ch[5] := Ch[5] AND NOT (w SHL 1);
  183.              END;
  184.          END;
  185.       3: BEGIN
  186.            Ch[6] := Ch[6] AND NOT w;
  187.            Ch[7] := Ch[7] AND NOT w;
  188.            IF w <> $C0 THEN
  189.              IF (Ch[4] AND (w SHL 2)) = 0 THEN
  190.                Ch[5] := Ch[5] AND NOT (w SHL 1);
  191.          END;
  192.     END;
  193.  
  194.   END;
  195.  
  196.  
  197.  
  198.  
  199. PROCEDURE InitVid43;
  200.   VAR
  201.     i, j, w: WORD;
  202.   BEGIN
  203.     OldExitProc := ExitProc;
  204.     ExitProc    := @MyExitProc;
  205.  
  206.     FOR i := 0 TO 255 DO BEGIN
  207.       FOR j := 0 TO 7 DO PixFont8x8[i][j] := $FF;
  208.  
  209.       w := $C0;
  210.       IF ( i SHR 6       ) > 0 THEN PokePixel(PixFont8x8[i], w,  i SHR 6);
  211.  
  212.       w := $30;
  213.       IF ((i SHR 4) AND 3) > 0 THEN PokePixel(PixFont8x8[i], w, (i SHR 4) AND 3);
  214.  
  215.       w := $0C;
  216.       IF ((i SHR 2) AND 3) > 0 THEN PokePixel(PixFont8x8[i], w, (i SHR 2) AND 3);
  217.  
  218.       w := $03;
  219.       IF ( i        AND 3) > 0 THEN PokePixel(PixFont8x8[i], w,  i        AND 3);
  220.     END;
  221.  
  222.     ASM
  223.                 MOV     AX,$1C00
  224.                 MOV     CX,$07
  225.                 INT     $10
  226.                 SUB     AL,$1C
  227.                 MOV     [SaveBufferNotValid],AL
  228.  
  229.                 MOV     [SaveBufferSize],BX
  230.     END;
  231.  
  232.     IF NOT SaveBufferNotValid THEN
  233.       FullHeap.HGetMem(SaveBufferRec.Buffer,  SaveBufferSize  * 64);
  234.  
  235.     ScrImageHandle.Init;
  236.   END;
  237.  
  238.  
  239.  
  240.  
  241. END.
  242.